################################################################
#  Print out demographic information about the entire group
#  such as age spread, number of women and men, and so forth.
################################################################


# demographic analysis
compute.demographics = function( P="allFolks.csv", augment.with.finals=FALSE ) {
	
if ( is.character( P ) ) {
	cat( "Loading file from name for demographic computation\n" )
	P = read.csv( P, stringsAsFactors=FALSE )
} 

#names(P)[1:66]
#P = P[1:66]

drops = c( "IDCode","groupStyle", "email","pubname","addList","who.gay","who.str", "remarks")

P = P[ !( names(P) %in% drops ) ]

rng = grep( "[1234]$", names(P) )
names(P)[rng]

P[ is.na(P) ] = ""
F = reshape( P, varying=names(P)[rng], direction="long", sep="" )

F = F[ F$age > 0, ]
names(F)
F = F[ !(names(F) %in% c("time","id")) ]


F$lookM = F$lookM == "yes"
F$lookW = F$lookW == "yes"

F$isTransM = F$isTransM=="yes"
F$isTransW = F$isTransW=="yes"
F$lookTransM = F$lookTransM=="yes"
F$lookTransW = F$lookTransW=="yes"
F$isGQ = F$isGQ == "yes"
F$lookGQ = F$lookGQ == "yes"


F$isMan = as.factor( F$isMan )
F$gender = "none"

F$gender[F$isGQ] = "GQ"
F$gender[F$isMan=="yes"] = "M"
F$gender[F$isTransM] = "TM"
F$gender[F$isWoman=="yes"] = "F"
F$gender[F$isTransW] = "TW"
F$gender[F$isTransM & F$isTransW] = "TB"
F$gender[F$isWoman=="yes" & F$isMan=="yes"] = "B"

#F$bi = F$lookM == "yes" & F$lookW == "yes"
#F$gay = (( F$lookM == "yes" & (F$gender=="M"|F$gender=="TM") ) | ( F$lookW == "yes" & (F$gender=="F"|F$gender=="TF") )) & !F$bi


F$sex = ifelse( F$lookM, "M", "" )
F$sex = paste( F$sex, ifelse( F$lookTransM, "*", "" ), sep="" )
F$sex = paste( F$sex, ifelse( F$lookW, "|W", "|" ), sep="" )
F$sex = paste( F$sex, ifelse( F$lookTransW, "*", "" ), sep="" )
F$sex = paste( F$sex, ifelse( F$lookGQ, "!", "" ), sep="" )

F$shortSex = ifelse( F$lookM | F$lookTransM, "M", "" )
F$shortSex = paste( F$shortSex, ifelse( F$lookW | F$lookTransW, "|W", "|" ), sep="" )

#F$sex[F$lookM | F$lookW] = "Str"
#F$sex[F$bi] = "Bi"
#F$sex[F$gay] = "Gay"

F$kinky = F$kinky="yes"


if ( augment.with.finals ) {
	
	## Add final match info to demographics
	fin = read.csv( "finals.csv" )
	fin = fin[ c("personID","num.matches","num.possible","num.desired","num.cruises") ]
	F = merge( F, fin )
	F
}

cat( "[demog] Demographic information written to indiv_folks.csv.\n" )
write.csv( F, file="indiv_folks.csv", quote=FALSE, row.names=FALSE )

class(F) <- c( "demographics", class(F) )
F
} # end compute.demographics




# demographic analysis
load.demographics = function( F, augment.with.finals=FALSE ) {

# build gender string
F$gender = "none"
F$gender[F$isGQ] = "GQ"
F$gender[F$isMan] = "M"
F$gender[F$isTransM] = "TM"
F$gender[F$isWoman] = "F"
F$gender[F$isTransW] = "TW"
F$gender[F$isTransM & F$isTransW] = "TB"
F$gender[F$isWoman & F$isMan] = "B"

#F$bi = F$lookM == "yes" & F$lookW == "yes"
#F$gay = (( F$lookM == "yes" & (F$gender=="M"|F$gender=="TM") ) | ( F$lookW == "yes" & (F$gender=="F"|F$gender=="TF") )) & !F$bi


F$sex = ifelse( F$lookM, "M", "" )
F$sex = paste( F$sex, ifelse( F$lookTransM, "*", "" ), sep="" )
F$sex = paste( F$sex, ifelse( F$lookW, "|W", "|" ), sep="" )
F$sex = paste( F$sex, ifelse( F$lookTransW, "*", "" ), sep="" )
F$sex = paste( F$sex, ifelse( F$lookGQ, "!", "" ), sep="" )

F$shortSex = ifelse( F$lookM | F$lookTransM, "M", "" )
F$shortSex = paste( F$shortSex, ifelse( F$lookW | F$lookTransW, "|W", "|" ), sep="" )


if ( augment.with.finals ) {
	
	## Add final match info to demographics
	fin = read.csv( "finals.csv" )
	fin = fin[ c("personID","num.matches","num.possible","num.desired","num.cruises") ]
	F = merge( F, fin )
	F
}

print( "[demog] Demographic information written to indiv_folks.csv\n" )
write.csv( F, file=INDIV_FOLKS_FILENAME, quote=FALSE, row.names=FALSE )

class(F) <- c( "demographics", class(F) )
F
} # end compute.demographics





## A decent summary to just pump out some basic stats
print.demographics = function( F ) {

	g = length( unique( F$personID[ duplicated(F$personID) ] ) )
	du = length( unique( F$personID ) )
	cat( "# People = ", nrow(F),  "  # entities = ", du, "  # groups = ", g,
			"  # in groups = ", (g + nrow(F)-du), "\n" )
	
	if ( is.character(F$noPrimary ) ) {
		F$noPrimary = F$noPrimary =="yes"
	}
	cat ( "     % non-primary = ", round( 100 * mean( F$noPrimary )), "%\n" )
	
	# if we have string stuff, then turn to factors
	if ( is.character(F$group) ) {
		F$group = as.factor( F$group )
		F$gender = as.factor(F$gender)
	}
	print( gtab<-with( F, table( group, gender ) ) )
	
	cat( sprintf( "     Ratio of men to woman = %.2f\n", gtab[1,2]/gtab[1,1] ) )
	
	cat( "Table of Folks by Gender and Sexual Orientation (%)\n")
	pers = round( 100 * prop.table( with( F, table( gender, shortSex ) ), margin=1 ) )
	cnts =  with( F, table( gender, shortSex ) )
	colnames(pers) = paste(colnames(pers), "%", sep="")
	pers = rbind( pers, rep(0, ncol(pers) ) )
	
	print( as.table( cbind( addmargins( cnts ), rep(0,nrow(pers+1)), pers)), zero.print=".")

#	cat( "Full Counts (#)\n")
#	print( with( F, table( gender, sex ) ), margin=1, zero.print="." )

	cat( "# Trans = ", sum(F$isTransM),  "/" , sum(F$isTransW), 
			"\tTrans friendly = ", sum(F$lookTransM), "/", sum(F$lookTransW),"\n", sep="" )
	cat( "# GQ = ", sum(F$isGQ), 
     		"\t\tGQ friendly = ", sum(F$lookGQ), "\n", sep="" )
     
    cat( "Ages (by decade): " )
	print( with( F, table( gender, 10*floor(age/10) ) ), zero.print="." )
	
	#with(F, table( lookGroup, group ) )
	
	if ( !is.null( F$matches ) ) {
		cat( "Matches (by gender):" )
	print( with( F, table( gender, ifelse( F$matches <= 10, F$matches,
								ifelse( F$matches > 50, 50, 5 * floor(F$matches/5) ) ) ) ), zero.print="." )
	cat( "Mean # matches:\n" )
	print( round( tapply( F$matches, F$gender, mean ), digits=1 ) )
	}
	
	cat( "Kinkiness and looking for kinkiness\n" ) 
	print( with( F, table( isKinky, lookKink ) ) )
	
	cat( "Location\n" )
	
	locs = grep( "^from", names(F) )
	locs = names(F)[locs]
	
	print(	sapply( locs, function( L ) { 
		if ( is.character(F[[L]]) ) {
			F[[L]] = as.numeric(F[[L]] == "yes")
		}
		paste( round( 100 * mean(F[L]) ), "%", sep="") } ) , quote=FALSE)
	
		
	invisible(0)
} 

showFinalMatchings = function( F ) {
	
	## Add final match info to demographics
	fin = read.csv( "finals.csv" )
#	fin = fin[ c("personID","num.matches","num.cruises") ]
	F = merge( F, fin )
	
		cat( "Summary of final match numbers\n" )
		print( with( F, table( gender, num.matches ) ) )
	
		cat( "Summary of final desired numbers\n" )
		print( with( F, table( gender, num.desired ) ) )
	
		cat( "Summary of final possible numbers\n" )
		print( with( F, table( gender, num.possible ) ) )
	
	F$satisfaction = F$num.matches / pmax( F$num.desired, 1 )
	boxplot( satisfaction ~ gender , data=F)

	F$gender[F$group=="yes"] = "group"
	stripchart( num.desired ~ gender , data=F, offset=0.15, method="stack")
	stripchart( num.possible ~ gender , data=F, offset=0.15, method="stack")
	
		print( with( F, table( gender, num.cruises ) ) )
}


showFolks = function( F, who ) {
	print( as.data.frame( F[who,] ) )
}



####################################################################################
## Other plots and what-not

extras = function() {

FF = F[ !(names(F) %in% c("first","last","personID")) ]
summary(FF)


plot( minAge ~ age, data=F, ylim=c(0,100) )
points( maxAge ~ age, data=F, pch=19 )
abline( lm( minAge ~ age, data=F ) )
abline( lm( maxAge ~ age, data=F ) )

stripchart( F$age, method="stack", main="Ages of participants" )

stripchart( F$age ~ F$gender, method="stack", main="Ages of participants (by gender)" )

byGen = split(F, F$gender )
sapply( byGen, function( x ) { summary(x$age) } )

table(F$gender, F$isGQ)
table(F$isGQ )


with( F, table( sex, gender ) )

with( subset( F, age <= 40 ), table( sex, gender ) )





## Looking at matching

sapply( byGen, function( x ) { summary(x$matches) } )



# once final results are in...
res$personID = rownames(res)

F = merge( F, res, by="personID" )

}
############################ end junk #################################################
